home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Deutsche Edition 1
/
Deutsche Edition 1.iso
/
amok
/
031-040
/
amok31
/
environment
/
mpcompile.mod
< prev
next >
Wrap
Text File
|
1993-11-04
|
10KB
|
280 lines
(* ********************************************************************** *)
(* Compilieren mit der Maus für beliebige Programmierumgebungen *)
(* MPCompile V3.0 --- © 1989 by M.Peuckert *)
(* ********************************************************************** *)
(*---------------------------------------------------------------------------
:Program. MPCompile
:Version. 3.0
:Contants. Compiling, linking, debugging, etc.
:History. V2.0, Markus Peuckert, Simple
:History. V3.0, Markus Peuckert, slightly improved version, Mar-89
:Author. Markus Peuckert
:Address. Schützenstr. 50, D-3550 Marburg, West-Germany,
:Copyright. PD
:Language. Modula-2
:Translator. M2Amiga V3.2d
---------------------------------------------------------------------------*)
MODULE MPCompile;
FROM SYSTEM IMPORT ADR,ADDRESS;
FROM Arts IMPORT Assert;
FROM Exec IMPORT WaitPort, GetMsg, ReplyMsg;
FROM Intuition IMPORT GadgetPtr, IntuiMessagePtr, IDCMPFlags, IDCMPFlagSet,
CloseWindow, WindowFlags, WindowFlagSet, ScreenFlags,
ScreenFlagSet, ActivationFlags, ActivationFlagSet,
WindowPtr, SetWindowTitles, RefreshGadgets,
ActivateGadget, RemoveGList, AddGList, SizeWindow,
MoveWindow;
FROM Graphics IMPORT SetRast;
FROM Dos IMPORT Execute;
FROM FileSystem IMPORT File;
FROM Strings IMPORT Occurs, Insert, Delete, Copy, Length, first, last;
FROM DosSupport IMPORT OpenCon, CloseCon, CD;
FROM IntuiSup IMPORT CreateWindow, IDCMPOn, IDCMPOff, ActivWindow;
FROM MPGad IMPORT MaxChar, DrawText,
compgad, linkgad, debuggad,rungad, exgad, edgad,
popgad, loadgad, savegad, compilgad, linkergad,
loadergad, prggad, editgad, CompilBuf, LinkerBuf,
LoaderBuf, PrgBuf, EditBuf, CompGad, LinkGad, DebugGad,
RunGad, ExGad, EdGad, PrgGad, PopGad, LoadGad;
FROM MPWin IMPORT WinLEFT, WinTOP, WinHEIGHT, WinWIDTH, DWidth, DHeight,
winTitle, win, win2, ConPtr, rp, rp2, fh;
FROM MPDat IMPORT OpenConfig, CloseConfig, GetConfigParams,
SetConfigParams;
VAR Datei : File;
PrgDir, FileName : ARRAY [0..MaxChar] OF CHAR;
ConTit : ARRAY [0..79] OF CHAR;
gadPos, realPos : INTEGER;
FixLeft, FixTop : INTEGER;
(* Liest s:Compi.config aus, wenn besteht, sonst wird neu eingerichtet *)
PROCEDURE LoadConfig;
BEGIN
OpenConfig (Datei, FALSE);
GetConfigParams (Datei, CompilBuf);
GetConfigParams (Datei, LinkerBuf);
GetConfigParams (Datei, LoaderBuf);
GetConfigParams (Datei, EditBuf);
CloseConfig (Datei);
RefreshGadgets (ADR(LoadGad), win2, NIL)
END LoadConfig;
(* Speichert Angaben des Eingabefensters in s:Compi.config *)
PROCEDURE SaveConfig;
BEGIN
OpenConfig (Datei, TRUE);
SetConfigParams (Datei, CompilBuf);
SetConfigParams (Datei, LinkerBuf);
SetConfigParams (Datei, LoaderBuf);
SetConfigParams (Datei, EditBuf);
CloseConfig (Datei);
END SaveConfig;
(* Ermittelt letztes Vorkommen von token(=CHAR) in Str *)
PROCEDURE LastPos (Str : ARRAY OF CHAR; token : CHAR; start : INTEGER) : INTEGER;
VAR i, len : INTEGER;
BEGIN
len := Length (Str);
FOR i:=len TO start BY -1 DO
IF (Str[i] = token) THEN
RETURN i
END
END;
RETURN -1
END LastPos;
(* Holt Laufwerksbezeichnung und Dateiname aus Eingabestring *)
PROCEDURE Extract (File : ARRAY OF CHAR; VAR dir, prefix : ARRAY OF CHAR);
VAR dirpos, prepos, subpos, len : INTEGER;
ok : BOOLEAN;
BEGIN
len := Length (File);
dirpos := Occurs (File, first, ":", FALSE);
subpos := LastPos (File, "/", first);
prepos := Occurs (File, first, ".", FALSE);
IF (subpos # last) THEN
Copy (dir, File, first, subpos+1);
ok := CD (dir);
IF (prepos # last) THEN Copy (prefix, File, subpos+1, prepos-subpos-1)
ELSE Copy (prefix, File, subpos+1, len-subpos-1) END
ELSIF (subpos = last) THEN
IF (dirpos # last) THEN
Copy (dir, File, first, dirpos+1);
ok := CD (dir);
IF (prepos # last) THEN Copy (prefix, File, dirpos+1, prepos-dirpos-1)
ELSE Copy (prefix, File, dirpos+1, len-dirpos-1) END
ELSIF (dirpos = last) THEN
IF (prepos # last) THEN Copy (prefix, File, first, prepos)
ELSE Copy (prefix, File, first, len) END
END
END
END Extract;
(* Führt übergebenen String als CLI-Kommando aus *)
PROCEDURE Exec (Prog : ARRAY OF CHAR);
VAR done : INTEGER;
BEGIN
done := Execute (ADR(Prog), NIL, fh);
END Exec;
(* Setzt Filenamen in Compileraufruf anstelle des Platzhalters ein *)
PROCEDURE Prepare (Envir, Prog : ARRAY OF CHAR);
VAR pos : INTEGER;
BEGIN
IF (Prog[0] = 0C) THEN RETURN END;
pos := Occurs (Envir, first, "#", FALSE);
Delete (Envir, pos, 1);
Insert (Envir, pos, Prog);
IDCMPOff (win);
Exec (Envir);
IDCMPOn (win, IDCMPFlagSet{closeWindow, gadgetUp, menuPick})
END Prepare;
(* Compilieren, Linken und ausführen *)
PROCEDURE RunAll (Comp, Link, Prog, Name : ARRAY OF CHAR);
BEGIN
Prepare (Comp, Prog);
Prepare (Link, Name);
Exec (Name);
END RunAll;
(* Setzt Titel des Ausgabefensters *)
PROCEDURE SetConTitle (Merge : ARRAY OF CHAR);
VAR pos : INTEGER;
BEGIN
ConTit := " MPCompile V3.0 --- Output : ";
pos := Occurs (ConTit, first, ":", FALSE);
Insert (ConTit, pos+2, Merge);
Insert (ConTit, Length (ConTit), " ");
SetWindowTitles (ConPtr, ADR(ConTit), NIL)
END SetConTitle;
(* Öffnet Eingabefenster *)
PROCEDURE OpenPop;
VAR ok : BOOLEAN;
BEGIN
win2 := CreateWindow (WinLEFT, WinTOP+WinHEIGHT+1, WinWIDTH, 115,
IDCMPFlagSet{closeWindow, gadgetUp, activeWindow},
WindowFlagSet{windowDrag, windowDepth, windowClose, windowActive,
gimmeZeroZero, activate}, ADR(LoadGad), NIL,
ADR(" MPCompile --- PopWindow Preferences "),
ScreenFlagSet{wbenchScreen});
Assert(win2#NIL,ADR("Kann Fenster nicht öffnen"));
rp2:=win2^.rPort;
DrawText (rp2);
IF (CompilBuf[0] = 0C) THEN LoadConfig END;
ok := ActivateGadget (ADR(PrgGad), win2, NIL);
END OpenPop;
(* Fragt Gadgets des Einganfensters ab *)
PROCEDURE GetPopWindow;
VAR Msg2 : IntuiMessagePtr;
class2 : IDCMPFlagSet;
adr2 : GadgetPtr;
BEGIN
OpenPop;
LOOP
WaitPort (win2^.userPort);
Msg2 := GetMsg (win2^.userPort);
WHILE Msg2#NIL DO
class2 := Msg2^.class; adr2 := Msg2^.iAddress;
ReplyMsg (Msg2);
IF (closeWindow IN class2) THEN EXIT END;
IF (gadgetUp IN class2) THEN
CASE adr2^.gadgetID OF
loadgad : LoadConfig |
savegad : SaveConfig |
prggad : Extract (PrgBuf, PrgDir, FileName) |
ELSE
END (* case *)
END; (* if *)
Msg2 := GetMsg (win2^.userPort)
END (* while *)
END; (* loop *)
IF win2#NIL THEN CloseWindow (win2); win2:=NIL END;
SetConTitle (PrgBuf)
END GetPopWindow;
(* Verkleinert das Steuerfenster *)
PROCEDURE MinWin;
VAR dXMov, dYMov : INTEGER;
BEGIN
IF fh#NIL THEN CloseCon (fh); fh := NIL END;
FixLeft := win^.leftEdge; FixTop := win^.topEdge;
gadPos := RemoveGList (win, ADR(CompGad), -1);
SetRast (rp, 0);
SizeWindow (win, -DWidth, -DHeight);
dXMov := 420 - win^.leftEdge; dYMov := 15 - win^.topEdge;
MoveWindow (win, dXMov, dYMov);
SetWindowTitles (win, ADR("MPCompile"), NIL)
END MinWin;
(* Vergrößert das Steuerfenster *)
PROCEDURE MaxWin;
VAR dXMov, dYMov : INTEGER;
BEGIN
fh := OpenCon ("CON:50/53/500/80/ MPCompile --- Output : ");
ConPtr := ActivWindow ();
SetConTitle (PrgBuf);
dXMov := FixLeft - win^.leftEdge; dYMov := FixTop - win^.topEdge;
MoveWindow (win, dXMov, dYMov);
SizeWindow (win, DWidth, DHeight);
SetWindowTitles (win, ADR(winTitle), NIL);
realPos := AddGList (win, ADR(CompGad), gadPos, -1, NIL);
RefreshGadgets (ADR(CompGad), win, NIL)
END MaxWin;
(* Holt Messages des Steuerfensters *)
PROCEDURE GetIntuiMsg;
VAR Msg : IntuiMessagePtr;
class : IDCMPFlagSet;
adr : GadgetPtr;
toggle : INTEGER;
BEGIN
toggle:=1;
LOOP
WaitPort (win^.userPort);
Msg := GetMsg (win^.userPort);
WHILE Msg#NIL DO
class := Msg^.class; adr := Msg^.iAddress;
ReplyMsg (Msg);
IF (closeWindow IN class) THEN EXIT END;
IF (menuPick IN class) THEN
toggle:=1-toggle;
IF (toggle = 0) THEN MinWin ELSE MaxWin END
END;
IF (gadgetUp IN class) THEN
CASE adr^.gadgetID OF
compgad : Prepare (CompilBuf, PrgBuf) |
linkgad : Prepare (LinkerBuf, FileName) |
debuggad : Prepare (LoaderBuf, FileName) |
rungad : RunAll (CompilBuf, LinkerBuf, PrgBuf, FileName) |
exgad : Exec (FileName) |
edgad : IF (PrgBuf[0]=0C) THEN Prepare (EditBuf, " ")
ELSE Prepare (EditBuf, PrgBuf) END |
popgad : GetPopWindow |
ELSE
END (* case *)
END; (* if *)
Msg := GetMsg (win^.userPort)
END (* while *)
END (* loop *)
END GetIntuiMsg;
VAR i : CARDINAL;
BEGIN
FOR i:=0 TO MaxChar DO PrgDir[i] := 0C; FileName[i] := 0C END;
GetPopWindow;
GetIntuiMsg;
END MPCompile.Mod